home *** CD-ROM | disk | FTP | other *** search
/ Revista do CD-ROM 39 / CD-ROM 39 / CD-ROM 39.iso / COLORDIC / MOUSE / COLORDIC.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-01-22  |  9.4 KB  |  234 lines
  1. Declare Function SetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
  2. Declare Function getpixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  3. Declare Function floodfill Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Integer
  4.  
  5. Global Const Dir_XY = "f:\plinio\colordic\XY\"
  6. Global Const Dir_Telas = "f:\plinio\colordic\TELAS\"
  7. Global Const Dir_Local = "f:\plinio\colordic\"
  8. Global Const DIR_BOTOES = "f:\plinio\colordic\BOTOES\"
  9. Global Const DIR_BOTOES_TXT = "f:\plinio\colordic\BOTOES\BOTOES.TXT"
  10. Global Const DIR_BALDES = "f:\plinio\colordic\BOTOES\BALDES.TXT"
  11. Global Const DIR_PORT_WAVE = "f:\plinio\colordic\PORTWAV\"
  12. Global Const DIR_ING_WAVE = "f:\plinio\colordic\INGWAV\"
  13. Global Const DIR_PORT_HSP = "f:\plinio\colordic\PORTHSP\"
  14. Global Const DIR_ING_HSP = "f:\plinio\colordic\INGHSP\"
  15. Global Const DIR_ENTRADA = "f:\plinio\colordic\icones\"
  16.  
  17. 'Global Const Dir_XY = "\colordic\XY\"
  18. 'Global Const Dir_Telas = "\colordic\TELAS\"
  19. 'Global Const Dir_Local = "c:\colordic\"
  20. 'Global Const DIR_BOTOES = "\colordic\BOTOES\"
  21. 'Global Const DIR_BOTOES_TXT = "\colordic\BOTOES\BOTOES.TXT"
  22. 'Global Const DIR_BALDES = "\colordic\BOTOES\BALDES.TXT"
  23. 'Global Const DIR_PORT_WAVE = "\colordic\PORTWAV\"
  24. 'Global Const DIR_ING_WAVE = "\colordic\INGWAV\"
  25. 'Global Const DIR_PORT_HSP = "\colordic\PORTHSP\"
  26. 'Global Const DIR_ING_HSP = "\colordic\INGHSP\"
  27. 'Global Const DIR_ENTRADA = "\colordic\icones\"
  28.  
  29. Global Lφngua As Integer
  30. Global Array_Ativo As Integer
  31. Global Array_Antigo As Integer
  32. Global Nome_Desenho(0 To 19) As String
  33. Global Tφtulo_Ingles(0 To 19) As String
  34. Global Tφtulo_Port(0 To 19) As String
  35. Global Contador_Usuario As Integer
  36. Global Num_Usuario(0 To 7) As Integer
  37. Global Contador_Botπo As Integer
  38. Global Desenho(0 To 19) As String
  39. Global cores(0 To 38) As Long
  40. Global Som_Liberado As Integer
  41. Global Tom_Var As Integer
  42.  
  43. '*****************************pincelh.bas**********************************
  44.  
  45. ' Windows API rectangle type
  46. Type RECT
  47.     Left As Integer
  48.     Top As Integer
  49.     right As Integer
  50.     bottom As Integer
  51. End Type
  52. '
  53. ' Windows API bitmap information type
  54. '
  55. Type BITMAP
  56.     bmType As Integer
  57.     bmWidth As Integer
  58.     bmHeight As Integer
  59.     bmWidthBytes As Integer
  60.     bmPlanes As String * 1
  61.     bmBitsPixel As String * 1
  62.     bmBits As Long
  63. End Type
  64. '
  65. ' Windows API task entry type
  66. '
  67. Type TaskEntry
  68.     dwSize          As Long
  69.     hTask           As Integer
  70.     hTaskParent     As Integer
  71.     hInst           As Integer
  72.     hModule         As Integer
  73.     wSS             As Integer
  74.     wSP             As Integer
  75.     wStackTop       As Integer
  76.     wStackMinimum   As Integer
  77.     wStackBottom    As Integer
  78.     wcEvents        As Integer
  79.     hQueue          As Integer
  80.     szModule        As String * 9
  81.     wPSPOffset      As Integer
  82.     hNext           As Integer
  83.     pad             As String * 1
  84. End Type
  85.  
  86. '
  87. ' Windows API bitmap functions
  88. '
  89. 'Declare Function bitblt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  90. Declare Function CreateBitmap Lib "GDI" (ByVal nWidth As Integer, ByVal Height As Integer, ByVal nPlanes As Integer, ByVal nBitCount As Integer, ByVal lpBits As Any) As Integer
  91. Declare Function GetBitmapBits Lib "GDI" (ByVal hBitmap As Integer, ByVal dwCount As Long, ByVal lpBits As Any) As Long
  92. '
  93. ' Windows API device context functions
  94. '
  95. Declare Function SetBKColor Lib "GDI" (ByVal hDC As Integer, ByVal crColor As Long) As Long
  96. Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer) As Integer
  97. 'Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
  98. '
  99. ' Windows API GDI Object functions
  100. '
  101. Declare Function getpixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  102. Declare Function floodfill Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Integer
  103.  
  104. 'Declare Function GetObject Lib "GDI" (ByVal hObject As Integer, ByVal nCount As Integer, lpObject As Any) As Integer
  105. Declare Function GetObjectGDI Lib "GDI" Alias "GetObject" (ByVal hObject As Integer, ByVal nCount As Integer, ByVal lpObject As Long) As Integer
  106. 'Declare Function GetObject Lib "GDI" (ByVal hObject As Integer, ByVal nCount As Integer, lpObject As Any) As Integer
  107. 'Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
  108. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  109. '
  110. ' Windows API cursor functions
  111. '
  112. Declare Function GetCursor Lib "User" () As Integer
  113. Declare Function SetCursor Lib "User" (ByVal hCursor As Integer) As Integer
  114. Declare Function CreateCursor Lib "User" (ByVal hInstance%, ByVal nXhotspot%, ByVal nYhotspot%, ByVal nWidth%, ByVal nHeight%, ByVal lpANDbitPlane As Any, ByVal lpXORbitPlane As Any) As Integer
  115. Global hCursorPrev As Integer
  116. '
  117. ' Windows API mouse functions
  118. '
  119. Declare Sub ReleaseCapture Lib "User" ()
  120. Declare Function SetCapture Lib "User" (ByVal hWnd As Integer) As Integer
  121. '
  122. ' Windows API miscelaneous functions
  123. '
  124. Declare Function PtInRect Lib "User" (lpRect As RECT, ByVal lpPoint As Any) As Integer
  125. Declare Function GetWindowTask Lib "User" (ByVal hWnd As Integer) As Integer
  126. Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
  127. Declare Function GetFocus Lib "User" () As Integer
  128. Declare Function GetCurrentTask Lib "Kernel" () As Integer
  129. Declare Function TaskFindHandle Lib "toolhelp.dll" (lpTask As TaskEntry, ByVal hTask As Integer) As Integer
  130. '
  131. ' Constants used with bitblt
  132. '
  133. Global Const SRCCOPY = &HCC0020     ' (DWORD) dest = source
  134. Global Const NOTSRCCOPY = &H330008  ' (DWORD) dest = (NOT source)
  135. Global Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
  136. Global Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  137. Global Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
  138. '
  139. ' Mouse messages
  140. '
  141. Global Const WM_MOUSEFIRST = &H200
  142. Global Const WM_MOUSEMOVE = &H200
  143. Global Const WM_LBUTTONDOWN = &H201
  144. Global Const WM_LBUTTONUP = &H202
  145. Global Const WM_LBUTTONDBLCLK = &H203
  146. Global Const WM_RBUTTONDOWN = &H204
  147. Global Const WM_RBUTTONUP = &H205
  148. Global Const WM_RBUTTONDBLCLK = &H206
  149. Global Const WM_MBUTTONDOWN = &H207
  150. Global Const WM_MBUTTONUP = &H208
  151. Global Const WM_MBUTTONDBLCLK = &H209
  152. Global Const WM_MOUSELAST = &H209
  153.  
  154. Global Desativado As Integer
  155. Global Qual_Hdc As Integer
  156. '****************************************************************************
  157.  
  158. Sub Carrega_Nome_Desenho ()
  159. Dim i As Integer
  160. 'Nome BMPS
  161. NTφtulo = FreeFile
  162. Open Dir_Telas & "Titulos.txt" For Input As #NTφtulo
  163. Do While Not EOF(NTφtulo)
  164.     Line Input #NTφtulo, Tφtulo_BMPS
  165.     Nome_Desenho(i) = Trim(Left(Tφtulo_BMPS, 12))
  166.     Tφtulo_Port(i) = Trim(Mid(Tφtulo_BMPS, 13, 21))
  167.     Tφtulo_Ingles(i) = Trim(Right(Tφtulo_BMPS, Len(Tφtulo_BMPS) - 33))
  168.     i = i + 1
  169. Loop
  170. Close #NTφtulo
  171. End Sub
  172.  
  173. Sub Grava_Cor ()
  174. Num_Arquivo_Output = FreeFile 'N·mero do arquivo a ser gravado
  175. 'Abre arquivo do Usuario a ser gravado
  176. Open Dir_Local & Num_Usuario(Contador_Usuario) & Array_Ativo & ".txt" For Output As Num_Arquivo_Output
  177. Num_Arquivo_Input = FreeFile  'N·mero do arquivo que contΘm as coordenadas
  178. 'Abre arquivo das coordenadas
  179. Open Dir_XY & Left(Nome_Desenho_PB(), Len(Nome_Desenho_PB()) - 3) & "XY" For Input As Num_Arquivo_Input
  180. Do While Not EOF(Num_Arquivo_Input)
  181.     Line Input #Num_Arquivo_Input, Linha_XY 'Pega a coordenada
  182.     Valor_X = Val(Left(Linha_XY, 3))
  183.     Valor_Y = Val(Right(Linha_XY, 3))
  184.     Cor = getpixel(Pintura.hDC, Valor_X, Valor_Y)
  185.     If Val(Left(Cor, 3)) <> -1 And Val(Mid(Cor, 5, 3)) <> -1 And Val(Right(Cor, 3)) <> -1 Then
  186.  
  187.         Linha = Linha_XY & " " & Cor
  188.         Print #Num_Arquivo_Output, Linha
  189.     End If
  190. Loop
  191. Close #Num_Arquivo_Input  'Fecha o arquivo das coordenadas
  192. Close #Num_Arquivo_Output 'Fecha o arquivo do Usuario
  193. End Sub
  194.  
  195. Function Nome_Desenho_PB () As String
  196. If Len(Nome_Desenho(Array_Ativo)) = 12 Then
  197.     Nome_Desenho_PB = Left(Nome_Desenho(Array_Ativo), Len(Nome_Desenho(Array_Ativo)) - 5) & "1.bmp"
  198. Else
  199.     'MsgBox Left(Nome_Desenho(Array_Ativo), Len(Nome_Desenho(Array_Ativo)) - 4) & "1.bmp"
  200.     Nome_Desenho_PB = Left(Nome_Desenho(Array_Ativo), Len(Nome_Desenho(Array_Ativo)) - 4) & "1.bmp"
  201. End If
  202. End Function
  203.  
  204. Sub Pinta_Desenho ()
  205. Dim Arquivo_Usuario As String
  206.         
  207. Guarda_┌ltima_Cor = Pintura.FillColor
  208. Arquivo_Usuario = Dir(Dir_Local & Num_Usuario(Contador_Usuario) & Array_Ativo & ".txt")
  209. If Len(Arquivo_Usuario) > 0 Then
  210.     Num_Arquivo = FreeFile
  211.     Open Dir_Local & Num_Usuario(Contador_Usuario) & Array_Ativo & ".txt" For Input As #Num_Arquivo
  212.     Do While Not EOF(Num_Arquivo)
  213.         Line Input #Num_Arquivo, Linha_XY
  214.         If Mid(Linha_XY, 9, Len(Linha_XY) - 8) <> "16777215" Then
  215.             Valor_X = Val(Left(Linha_XY, 3))
  216.             Valor_Y = Val(Mid(Linha_XY, 5, 3))
  217.             Pintura.FillColor = Mid(Linha_XY, 9, Len(Linha_XY) - 8)
  218.             a = floodfill(Pintura.hDC, Val(Valor_X), Val(Valor_Y), &H0)
  219.             If Cont = 3 Then
  220.                 Pintura.Refresh
  221.                 Cont = 0
  222.             Else
  223.                 Cont = Cont + 1
  224.             End If
  225.         End If
  226.     Loop
  227.     Close #Num_Arquivo
  228.     Pintura.Refresh
  229. End If
  230. Pintura.FillColor = Guarda_┌ltima_Cor
  231.  
  232. End Sub
  233.  
  234.